Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue36/frmcache/FormCaching.pas

Pascal/Delphi Source File | 1998-05-29 | 5.6 KB | 212 lines

unit FormCaching;

// Provides a FormCache object to handle form caching
// Written by Philip Brown of Informatica Consultancy & Development
// [e-mail]

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms;

type
  TFormCacheItem = record
    DateTimeLastUsed: TDateTime;
    Form: TForm;
    IsInUse: Boolean;
  end;
  PFormCacheItem = ^TFormCacheItem;

  TFormCache = class
  private
    FormList: TList;
    FMaximumCacheSize: Integer;
    function GetForms (Index: Integer): PFormCacheItem;
    constructor Create;
    destructor Destroy; override;
    function GetCount: Integer;
    function GetActiveCount: Integer;
    procedure SetMaximumCacheSize (Value: Integer);
  protected
    property Forms[Index: Integer]: PFormCacheItem read GetForms; default;
  public
    function CreateForm (FormClassToCreate: TFormClass): TForm;
    procedure FreeForm (FormToFree: TForm);
    property MaximumCacheSize: Integer read FMaximumCacheSize write SetMaximumCacheSize;
    property Count: Integer read GetCount;
    property ActiveCount: Integer read GetActiveCount;
  end;

var
  FormCache: TFormCache;

implementation

// TFormCache

constructor TFormCache.Create;
begin
  inherited;
  FormList := TList.Create;
  FMaximumCacheSize := 10;
end;

destructor TFormCache.Destroy;
var
  ThisForm: Integer;
begin
  for ThisForm := 0 to Count - 1 do begin
    Forms[ThisForm]^.Form.Free;
    Dispose (FormList[ThisForm]);
  end;
  FormList.Free;
  inherited;
end;

function TFormCache.GetCount: Integer;
begin
  Result := FormList.Count;
end;

function TFormCache.GetActiveCount: Integer;
var
  ThisForm: Integer;
begin
  Result := 0;
  for ThisForm := 0 to Count - 1 do begin
    if Forms[ThisForm]^.IsInUse then begin
      Inc (Result);
    end;
  end;
end;

procedure TFormCache.SetMaximumCacheSize (Value: Integer);
var
  ThisForm: Integer;
begin
  FMaximumCacheSize := Value;
  ThisForm := 0;
  while (ThisForm < Count) and (Count > MaximumCacheSize) do begin
    with Forms[ThisForm]^ do begin
      if IsInUse then begin
        Inc (ThisForm);
      end else begin
        // cache can be reduced
        Form.Free;
        Dispose (FormList[ThisForm]);
        FormList.Delete (ThisForm);
      end;
    end;
  end;
end;

function TFormCache.GetForms (Index: Integer): PFormCacheItem;
begin
  Result := PFormCacheItem (FormList[Index]);
end;

function TFormCache.CreateForm (FormClassToCreate: TFormClass): TForm;
var
  FormCacheItemPtr: PFormCacheItem;
  ThisIndex: Integer;
  OldestDate: TDateTime;
  OldestFormIndex: Integer;
begin
  Result := nil;
  OldestDate := Now;
  OldestFormIndex := -1;
  ThisIndex := 0;
  while (Result = nil) and (ThisIndex < Count) do begin
    // test for class match
    with Forms[ThisIndex]^ do begin
      if not IsInUse then begin
        if (Form <> nil) and (Form.ClassType = FormClassToCreate) then begin
          Result := Form;
          IsInUse := True;
          // call the form OnCreate event if it is Assigned
          if Assigned (Result.OnCreate) then begin
            Result.OnCreate (Result);
          end;
        end else if DateTimeLastUsed < OldestDate then begin
          // remember the oldest "slot" available for a new form
          OldestFormIndex := ThisIndex;
          OldestDate := DateTimeLastUsed;
        end;
      end;
    end;
    Inc (ThisIndex);
  end;
  // if Result is nil then we have failed to find a useable, cached entry so
  // we must create one
  if Result = nil then begin
    // no cached entry exists, we must create a new instance using standard methods
    Result := FormClassToCreate.Create (nil);
    // check to see if our cache can accept this new form
    if Count = MaximumCacheSize then begin
      // not allowed to add another cached form to the list, see if we had a reusable slot in the cache
      if OldestFormIndex <> -1 then begin
        // reuse the oldest cache entry
        with Forms[OldestFormIndex]^ do begin
          // free up the old form
          Form.Free;
          // assign our new one to the cache
          Form := Result;
          IsInUse := True;
        end;
      end;
    end else begin
      // add this form to the cache
      New (FormCacheItemPtr);
      FormCacheItemPtr^.DateTimeLastUsed := 0;
      FormCacheItemPtr^.Form := Result;
      FormCacheItemPtr^.IsInUse := True;
      FormList.Add (FormCacheItemPtr);
    end;
  end;
end;

procedure TFormCache.FreeForm (FormToFree: TForm);
var
  FoundForm: Boolean;
  ThisIndex: Integer;
begin
  // try and find the form in the cache
  ThisIndex := 0;
  FoundForm := False;
  while (not FoundForm) and (ThisIndex < Count) do begin
    with Forms[ThisIndex]^ do begin
      if Form = FormToFree then begin
        // found instance, free it up
        FoundForm := True;
        if Count > MaximumCacheSize then begin
          // shrink the cache - remove the cache entry
          Form.Free;
          Dispose (FormList[ThisIndex]);
          FormList.Delete (ThisIndex);
        end else begin
          // flag cache entry as available and timestamp it
          IsInUse := False;
          DateTimeLastUsed := Now;
        end;
      end else begin
        Inc (ThisIndex);
      end;
    end;
  end;
  // if we could not find the form in the cache then we should just free it -
  // it was not in the cache in the first place
  if not FoundForm then begin
    FormToFree.Free;
  end
end;

// unit routines

initialization
  FormCache := TFormCache.Create;

finalization
  FormCache.Free;

end.